home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / copyRing.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  2.2 KB  |  109 lines  |  [TEXT/ALFA]
  1. # Implementation of Emacs's kill ring. This is a paste ring.
  2.  
  3. if {[catch {set renamedRing}]} {
  4.     set renamedRing 1
  5.     rename copy oldCopy
  6.     rename cut oldCut
  7.     rename paste oldPaste
  8. }
  9.  
  10. set ringDepth     10
  11. set ringIn         0
  12. set ringOut         0
  13. set pasteStart     0
  14. set pasteFinish    0
  15.  
  16.  
  17. proc copy {} {
  18.     global copyring ringDepth ringIn
  19.     
  20.     set len [expr {[selEnd] - [getPos]}]
  21.     if {!$len} {
  22.         if {[getMark] < [getPos]} {
  23.             set text [getText [getMark] [getPos]]
  24.         } else {
  25.             set text [getText [getPos] [getMark]]
  26.         }
  27.         if {![string length $text]} return
  28.     } else {
  29.         set text [getSelect]
  30.     }
  31.     set copyring([expr {$ringIn % $ringDepth}]) $text
  32.  
  33.     incr ringIn
  34.     
  35.     oldCopy
  36. }
  37.  
  38.  
  39. proc cut {{rect 0}} {
  40.     global copyring ringDepth ringIn intelCutPaste
  41.     
  42.     set len [expr {[selEnd] - [getPos]}]
  43.     if {!$len} {
  44.         if {[getMark] < [getPos]} {
  45.             set text [getText [getMark] [getPos]]
  46.         } else {
  47.             set text [getText [getPos] [getMark]]
  48.         }
  49.         if {![string length $text]} return
  50.     } else {
  51.         set text [getSelect]
  52.     }
  53.     set copyring([expr {$ringIn % $ringDepth}]) $text
  54.  
  55.     incr ringIn
  56.     
  57.     oldCut
  58.  
  59.     if {$intelCutPaste && !$rect} {
  60.         if {[isWhite 0] && [isWhite -1]} {
  61.             backSpace
  62.         }
  63.     }
  64. }
  65.  
  66. proc paste {{rect 0}} {
  67.     global copyring ringDepth ringIn ringOut intelCutPaste pasteStart pasteFinish
  68.     set intel 0
  69.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  70.     if {!$rect && $intelCutPaste} {
  71.         set left -1
  72.         set right [expr [selEnd] - [getPos]]
  73.         if {[isWhite $right] && [isChar $left]} {
  74.             clear
  75.             insertText " "
  76.         } elseif {[isWhite $left] && [isChar $right]} {set intel 1}
  77.     }
  78.     oldPaste
  79.     set pasteStart [getMark]
  80.     set pasteFinish [getPos]
  81.     if {$intel && ([lookAt [expr [getPos]-1]] != "\r")} {
  82.         insertText " "
  83.     }
  84. }
  85.  
  86.  
  87. proc isWhite {off} {
  88.     set c [lookAt [expr [getPos] + $off]]
  89.     return [expr {($c == " ")}]
  90. }
  91.  
  92. proc isChar {off} {
  93.     set c [lookAt [expr [getPos] + $off]]
  94.     return [expr {[string match {[a-z]} $c]}]
  95. }
  96.  
  97.     
  98. proc pastePop {} {
  99.     global copyring ringDepth ringIn ringOut pasteFinish pasteStart
  100.     
  101.     if {!$ringIn} { beep; return}
  102.     
  103.     set ringOut [expr $ringOut-1]
  104.     if {$ringOut < 0} {set ringOut [expr (($ringDepth > $ringIn) ? $ringIn : $ringDepth) - 1]}
  105.     
  106.     replaceText $pasteStart $pasteFinish $copyring($ringOut)
  107.     set pasteFinish [expr $pasteStart + [string length $copyring($ringOut)]]
  108. }
  109.